perm filename MKIMAG[1,BGB] blob
sn#023227 filedate 1973-02-23 generic text, type T, neo UTF8
00100 SUBR(CRE)------------------------------------------------------
00200 BEGIN CRE;(Q1,Q2) - MAKE CRE STRUCTURE - BGB - 6 DEC 1972.
00300
00400 ;BIT POSITIONS OF THE ARGUMENTS Q1 & Q2 ENABLE INTENSITY CUTS.
00500 LAC 1,ARG2↔DAC 1,Q0
00600 LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1
00700 SETZM CUT#
00800
00900 SETQ IMAGE,{MKIMAG,FILM}
01000 CALL(SEGTV)
01100
01200 ;FIND AN INTENSITY CONTOUR ENABLE BIT.
01300 L0: LAC 0,Q0↔LAC 1,Q1
01400 L1: AOS 2,CUT↔LSHC 0,1↔JUMPL 0,L2
01500 CAMN 0,1↔JUMPE 0,L5↔GO L1
01600
01700 ;THRESHOLD THE TVBUF
01800 L2: DAC 0,Q0↔DAC 1,Q1
01900 CALL(THRESH,CUT)
02000 CALL(PACXOR)
02100
02200 ;MAKE LEVEL NODE WITH A RING OF POLYGON NODES.
02300 SETQ(LEVEL,{MKLEVL,IMAGE,CUT})
02400 L3: SETQ(POLYGON,{MKPGON,LEVEL})
02500 JUMPN 1,L3↔LAC 1,LEVEL↔SON 1,1↔JUMPE 1,L0
02600
02700 ;LEVEL OPERATIONS.
02800 L4:
02900 CALL(BABYKILLER,LEVEL)
03000 CALL(STADPY)
03100 GO L0
03200
03300 ;IMAGE OPERATIONS.
03400 L5: SETZ↔SKIPE FLGKRK↔CORE2↔JFCL
03500 LAC 1,IMAGE↔POP2J
03600
03700 DECLARE{Q0,Q1}
03800 BEND;1/10/73------------------------------------------------------
03900 DECLARE{IMAGE,LEVEL,POLYGON}
00100 SUBR(MKIMAG)FILM--------------------------------------------------
00200 BEGIN MKIMAG; MAKE IMAGE NODE - BGB - 10 JANUARY 1973.
00300 SETQ(IMAGE,{MAKE,[IBIT+IMGREL]})
00400 CALL(RINGIN,IMAGE,FILM)
00500 LAC 1,IMAGE↔LAC 2,FILM
00600 SON. 1,2↔DAD. 2,1
00700 LIPI 1,(1)↔DAC 1,3(1)↔DAC 1,4(1)↔DAC 1,5(1) ;FEV-RINGS.
00800 POP1J
00900 BEND;1/10/73------------------------------------------------------
01000
01100 SUBR(MKLEVL)IMAGE,CUT---------------------------------------------
01200 BEGIN MKLEVL; MAKE LEVEL NODE - BGB - 10 JANUARY 1973.
01300 SETQ(LEVEL,{MAKE,[LBIT+LVLREL]})
01400 CALL(RINGIN,LEVEL,IMAGE)
01500 LAC 1,LEVEL↔LAC 2,IMAGE
01600 SETO↔NCNT. 0,1
01700 SKIPGE↔SON. 1,2↔DAD. 2,1
01800 POP2J
01900 BEND;1/10/73------------------------------------------------------